home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0014_GREATFAD.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  2KB  |  121 lines
  1. {
  2. John Wong
  3.  
  4. >Does anyone out there have any fade-in routines??? Also can anyone
  5. >recomend some good books on VGA Programming and Animation???
  6.  
  7. This might be a fade out routine, but you could modify it to fade in.
  8. }
  9. {$G+}
  10. Program fades;
  11.  
  12. Uses
  13.   Crt, Dos;
  14.                   { TPC /$G+ To Compile }
  15. Var
  16.   All_RGB : Array[1..256 * 3] Of Byte;
  17.   x,color : Integer;
  18.  
  19.  
  20. Procedure FadeOut2; { This is Hard Cores Fade Out }
  21. begin
  22.   {for using Textmode use color 7, or For Graphics}
  23.   x := 1;
  24.   Color := 7;
  25.   Repeat;
  26.     port[$3c8] := color;
  27.     port[$3c9] := 60 - x;
  28.     port[$3c9] := 60 - x;
  29.     port[$3c9] := 60 - x;
  30.     inc(x);
  31.     Delay(75);
  32.   Until x = 60;
  33.  
  34.          { Get The Screen Back ( Change This ) }
  35.   Color := 7;
  36.   port[$3c8] := color;
  37.   port[$3c9] := 60 + x;
  38.   port[$3c9] := 60 + x;
  39.   port[$3c9] := 60 + x;
  40.   inc(x);
  41.   Delay(25);
  42. end;
  43.  
  44. Procedure FadeOut;
  45. Label
  46.   OneCycle,
  47.   ReadLoop,
  48.   DecLoop,
  49.   Continue,
  50.   Retr,
  51.   Wait,
  52.   Retr2,
  53.   Wait2;
  54. begin { FadeOut }
  55.   Asm
  56.     MOV   CX,64
  57.   OneCycle:
  58.  
  59.     MOV     DX,3DAh
  60.   Wait:   in      AL,DX
  61.     TEST    AL,08h
  62.     JZ      Wait
  63.   Retr:   in      AL,DX
  64.     TEST    AL,08h
  65.     JNZ     Retr
  66.  
  67.     MOV   DX,03C7h
  68.     xor   AL,AL
  69.     OUT   DX,AL
  70.     INC   DX
  71.     INC   DX
  72.     xor   BX,BX
  73.   ReadLoop:
  74.     in    AL,DX
  75.     MOV   Byte Ptr All_RGB[BX],AL
  76.     INC   BX
  77.     CMP   BX,256*3
  78.     JL    ReadLoop
  79.  
  80.     xor   BX,BX
  81.   DecLoop:
  82.     CMP   Byte Ptr All_RGB[BX],0
  83.     JE    Continue
  84.     DEC   Byte Ptr All_RGB[BX]
  85.  
  86.   Continue:
  87.     INC   BX
  88.     CMP   BX,256*3
  89.     JL    DecLoop
  90.  
  91.     MOV     DX,3DAh
  92.   Wait2:   in      AL,DX
  93.     TEST    AL,08h
  94.     JZ      Wait2
  95.   Retr2:   in      AL,DX
  96.     TEST    AL,08h
  97.     JNZ     Retr2
  98.  
  99.     MOV   DX,03C8h
  100.     MOV   AL,0
  101.     OUT   DX,AL
  102.     INC   DX
  103.     MOV   SI,OFFSET All_RGB
  104.     CLD
  105.     PUSH  CX
  106.     MOV   CX,256*3
  107.     REP   OUTSB
  108.     POP   CX
  109.  
  110.     LOOP  OneCycle
  111.  
  112.   end;
  113. end; { FadeOut }
  114.  
  115.  
  116. begin
  117.   fadeout;
  118.   NormVideo;
  119.   Fadeout2;
  120. end.
  121.